home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1988 / 05 / porter / nonpas.pas < prev   
Pascal/Delphi Source File  |  1988-04-04  |  5KB  |  155 lines
  1. PROGRAM nonpas;
  2.  
  3.   { Reads a non-Pascal database table with a header record }
  4.   { and some number of fixed-length data records           }
  5.  
  6. CONST signature = 19364;                     { application signature }
  7.       divider = '---------------------------------------------------';
  8.  
  9. TYPE  s20            = STRING [20];
  10.       pac            = PACKED ARRAY [1..20] OF CHAR;
  11.  
  12.       headrec = RECORD CASE tag : INTEGER OF
  13.       1: (signature  : WORD;               { This is the real layout }
  14.           nrecs      : WORD;                        { # data records }
  15.           placeholdr : PACKED ARRAY [1..10] OF CHAR;    { table name }
  16.           reclen     : INTEGER;                 { data record length }
  17.           datastart  : LONGINT;               { file offset for data }
  18.           descrsize  : INTEGER;              { field descriptor size }
  19.           ndescr     : INTEGER);          { number of fields per rec }
  20.       2: (dummy1,
  21.           dummy2     : WORD;
  22.           tablename  : pac);                  { To fool typechecking }
  23.       3: (stream     : PACKED ARRAY [1..24] OF BYTE);
  24.       END;
  25.  
  26.       fieldrec = RECORD CASE tag : INTEGER OF
  27.       1: (fname      : pac;
  28.           ftype      : INTEGER;
  29.           flen       : INTEGER);
  30.       2: (stream     : PACKED ARRAY [1..24] OF BYTE);
  31.       END;
  32.  
  33. VAR   header   : headrec;
  34.       field    : ARRAY [1..10] OF fieldrec;            { descriptors }
  35.       n        : INTEGER;
  36.       table    : FILE OF BYTE;
  37. { --------------------------- }
  38.  
  39. FUNCTION asciiz (max : INTEGER; VAR strng : pac) : s20;
  40.  
  41.     { Returns a Pascal string from a null-terminated string
  42.         that is <= max bytes long }
  43.  
  44. VAR   i      : INTEGER;
  45.       result : STRING [20];
  46.  
  47. BEGIN
  48.   result := '';
  49.   FOR i := 1 TO max DO
  50.     IF strng [i] <> CHR (0) THEN
  51.     result := result + strng [i];
  52.   asciiz := result;
  53. END;
  54. { --------------------------- }
  55.  
  56. PROCEDURE getDescriptors;
  57.  
  58.     { Reads field descriptors from header record }
  59.  
  60. VAR   c, d : INTEGER;
  61.  
  62. BEGIN
  63.   FOR d := 1 to header.ndescr DO
  64.     FOR c := 1 TO header.descrsize DO
  65.       READ (table, field [d].stream [c]);
  66. END;
  67. { --------------------------- }
  68.  
  69. PROCEDURE showHeaderInfo;
  70.  
  71.     { List information about the file format }
  72.  
  73. VAR   d : INTEGER;
  74.  
  75. BEGIN
  76.   WRITELN (divider);
  77.   WRITELN ('Table name is ',
  78.            asciiz (10, header.tablename));
  79.   WRITELN ('Table contains ', header.nrecs, ' records');
  80.   WRITELN ('Data record length in bytes is ',
  81.            header.reclen);
  82.   WRITELN ('Each record contains ', header.ndescr, ' fields:');
  83.   getDescriptors;
  84.   FOR d := 1 TO header.ndescr DO BEGIN
  85.     WRITELN ('  Field name:    ', asciiz (20, field [d].fname));
  86.     WRITE   ('  Data type:     ');
  87.     CASE field [d].ftype OF
  88.       0: WRITELN ('Integer');
  89.       1: WRITELN ('Character');
  90.     END;
  91.     WRITELN ('  Length:        ', field [d].flen);
  92.     WRITELN;
  93.   END;
  94.   WRITELN ('Data records follow:');
  95.   WRITELN;
  96. END;
  97. { --------------------------- }
  98.  
  99. PROCEDURE showData;
  100.  
  101.       { List contents of each data record by fieldname }
  102.  
  103. TYPE  int = RECORD CASE tag : INTEGER OF
  104.         1: (number : INTEGER);
  105.         2: (stream : PACKED ARRAY [1..2] OF BYTE);
  106.       END;
  107.  
  108. TYPE  charfield = RECORD CASE tag : INTEGER OF
  109.         1: (bf : PACKED ARRAY [1..20] OF BYTE);
  110.         2: (cf : pac);
  111.       END;
  112.  
  113. VAR   rec, descr, n : INTEGER;
  114.       intfield      : int;                      { integer data field }
  115.       chfield       : charfield;              { character data field }
  116.  
  117. BEGIN
  118.   FOR rec := 1 TO header.nrecs DO                  { For each record }
  119.     FOR descr := 1 TO header.ndescr DO BEGIN        { For each field }
  120.       WRITE (asciiz (20, field [descr].fname));          { Show name }
  121.       FOR n := LENGTH (asciiz (20, field [descr].fname)) TO 25 DO
  122.         WRITE (' ');                              { cosmetic spacing }
  123.       CASE field [descr].ftype OF
  124.         0: BEGIN
  125.              FOR n := 1 TO 2 DO
  126.                READ (table, intfield.stream [n]);    { get int field }
  127.              WRITELN (intfield.number);
  128.            END;
  129.         1: BEGIN
  130.              FOR n := 1 TO field [descr].flen DO
  131.                READ (table, chfield.bf [n]);   { get character field }
  132.              WRITELN (asciiz (20, chfield.cf));
  133.            END;
  134.       END;
  135.     END;
  136. END;
  137. { --------------------------- }
  138.  
  139. BEGIN
  140.   ASSIGN (table, 'DATABASE.XYZ');                       { open table }
  141.   RESET (table);
  142.   FOR n := 1 TO 24 DO                           { read header record }
  143.     READ (table, header.stream [n]);
  144.   IF signature <> header.signature THEN
  145.     WRITELN ('File not in proper format. Program ended.')
  146.   ELSE
  147.     BEGIN
  148.       showHeaderInfo;                     { Show info about the file }
  149.       SEEK (table, header.datastart);          { go to start of data }
  150.       showData;                            { List each record's data }
  151.     END;
  152.   CLOSE (table);
  153. END.
  154.  
  155.